perm filename FILLX.FAI[NEW,LCS]1 blob
sn#152176 filedate 1975-03-21 generic text, type T, neo UTF8
00100 TITLE FILL
00200 ENTRY FILLER,LINES,PLOT,PLOTS
00400 DEFINE FLOAT(N)
00500 < TLC N,232000
00600 FADR N,N >
00700 DEFINE FIXX(N)
00800 < JUMPGE N,.+5
00900 MOVNS N
01000 FIX N,233000
01100 MOVNS N
01200 CAIA
01300 FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
01400
01500 KK←2 ↔ L←3 ↔ LE←4 ↔ T←5 ↔ J←1
01600 RL←6 ↔ RJ←7 ↔ B←0 ↔ H←11 ↔ JK←10
01700 HG←12 ↔ D←13 ↔ AL←14 ↔ JJ←15
01800
01900 ; SUBROUTINE FILLER(Q,M)
02000 FILLER: 0
02100 MOVEM 16,SV16#
02200 HRRZ J,(16)
02300 HRRZM J,SVQ#
02400 HRRZ T,@1(16)
02500 HRRZM T,SVM# ; KK=NE(1)
02600 HRRZ KK,2(J)
02700 ADDI KK,-1(J)
02800 ; DO 4 K=2,KK
02900 HRRZI L,2(J)
03000 ; IF(NE(K).NE.3)GO TO 11
03100 L4: ADDI L,3
03200 HRRZ T,(L)
03300 L11: SETZM (L)
03400 CAIN T,3
03500 ; NE(K)=-1
03600 SETOM (L)
03700 ; GO TO 4
03800 ; 11 NE(K)=0
03900 ; 4 CONTINUE
04000 CAIGE L,(KK)
04100 JRST L4
04200 ; RLFT=10000
04300 MOVE RL,[=10000.0]
04400 ; RT=-10000
04500 MOVN RJ,[=10000.0]
04600 ; B=RT
04700 MOVE B,RJ
04800 ; DO 12 K=1,KK
04900 HRRZI L,-3(J)
05000 ; H=IFIX(Q(K))
05100 L12: ADDI L,3
05200 MOVE H,(L)
05300 FIXX(H)
05400 FLOAT(H)
05500 ; IF(H.LT.RLFT)RLFT=H
05600 CAMGE H,RL
05700 MOVE RL,H
05800
05900 ; IF(H.GT.RT)RT=H
06000 CAMLE H,RJ
06100 MOVE RJ,H
06200 ; IF(H.EQ.B)NE(K)=-1
06300 CAMN H,B
06400 SETOM 2(L)
06500 ; B=H
06600 MOVE B,H
06700 ; Q(K)=H
06800 MOVEM H,(L)
06900 ; 12 R(K)=IFIX(R(K))
07000 MOVE T,1(L)
07100 FIXX(T)
07200 FLOAT(T)
07300 MOVEM T,1(L)
07400 CAIGE L,-2(KK)
07500 JRST L12
07600 ; NE(KK+1)=-1
07700 SETOM 3(KK)
07800
07900 ; LRT=RT
08000 FIXX(RJ)
08100 MOVEM RJ,LRT#
08200 ; JA=3
08300 HRRZI T,3
08400 HRRZM T,JA#
08500
08600
08700 ; 124 LEFT=RLFT
08800 L124: MOVE LE,RL
08900 FIXX(LE)
09000 ; 51 J=LEFT
09100 L51: MOVE J,LE
09200 ; 42 RJ=J+.001
09300 L42: MOVE RJ,J
09400 FLOAT(RJ)
09500 FADR RJ,[=0.001]
09600 ; JCONT=0
09700 SETZM JCONT#
09800 ; LEFT=J
09900 MOVE LE,J
10000
10100 ; JJ=-1
10200 SETO JJ,
10300 ; ALT=-10000.
10400 MOVN AL,[=10000.0]
10500 ; 200 DO 45 L=2,KK
10600 HRRZ L,SVQ
10700 L45: ADDI L,3
10800 CAILE L,-2(KK)
10900 JRST L455
11000 ; IF(NE(L).NE.0)GO TO 45
11100 SKIPE 2(L)
11200 JRST L45
11300 ; IF(MISS(L,RJ,Q))GO TO 45
11400 CAML RJ,-3(L)
11500 JRST L201
11600 CAMLE RJ,(L)
11700 JRST L202
11800 L201: CAMGE RJ,(L)
11900 CAMG RJ,-3(L)
12000 JRST L45
12100 ; H=HGHT(L,RJ,Q,R)
12200 L202: MOVE H,-2(L)
12300 CAMN H,1(L)
12400 JRST RET
12500 MOVNS H
12600 FADR H,1(L)
12700 MOVE D,-3(L)
12800 MOVNS T,D
12900 FADR T,RJ
13000 FADR D,(L)
13100 FMPR H,T
13200 FDVR H,D
13300 FADR H,-2(L)
13400 ; IF(H.LT.ALT)GO TO 45
13500 RET: CAMGE H,AL
13600 JRST L45
13700
13800 ; ALT=H
13900 MOVE AL,H
14000 ; JJ=L
14100 HRRZI JJ,(L)
14200 ; 45 CONTINUE
14300 JRST L45
14400 ; IF(JJ)GO TO 43
14500 L455: JUMPL JJ,L43
14600 ; JCONT=-1
14700 SETOM JCONT
14800 ; LEFT=J
14900 MOVE LE,J
15000 ; 46 JA=3
15100 L46: HRRZI T,3
15200 HRRZM T,JA
15300 ; JORD=-1
15400 SETOM JORD#
15500 ; 52 KN=Q(JJ)
15600 L52: MOVE T,(JJ)
15700 FIXX(T)
15800 MOVEM T,KN#
15900 ; KL=Q(JJ-1)
16000 MOVE T,-3(JJ)
16100 FIXX(T)
16200
16300 MOVEM T,KL#
16400 ; IF(KN.LT.KL)KN=KL
16500 CAMLE T,KN
16600 MOVEM T,KN
16700 ; 50 I=J
16800 L50: MOVEM J,I#
16900 ; 102 RJ=I+.01
17000 L102: MOVE RJ,I
17100 FLOAT(RJ)
17200 FADR RJ,[=0.01]
17300 ; ALT=HGHT(JJ,RJ,Q,R)
17400 MOVE AL,-2(JJ)
17500 CAMN AL,1(JJ)
17600 JRST RET2
17700 MOVNS AL
17800 FADR AL,1(JJ)
17900 MOVE D,-3(JJ)
18000 MOVNS T,D
18100 FADR T,RJ
18200 FADR D,(JJ)
18300 FMPR AL,T
18400 FDVR AL,D
18500 FADR AL,-2(JJ)
18600 ; B=-10000
18700 RET2: MOVN B,[=10000.0]
18800 ; JK=-1
18900 SETO JK,
19000 ; XALT=ALT+.001
19100 MOVE T,AL
19200 FADR T,[=0.001]
19300 MOVEM T,XALT#
19400
19500 ; ZALT=ALT
19600 MOVEM AL,ZALT#
19700 ; 400 DO 47 L=2,KK
19800 MOVE L,SVQ
19900 L47: ADDI L,3
20000 CAILE L,-2(KK)
20100 JRST L477
20200 ; IF(L.EQ.JJ.OR.MISS(L,RJ,Q).OR.NE(L).LT.0)GO TO 47
20300 CAME L,JJ
20400 SKIPGE 2(L)
20500 JRST L47
20600 CAML RJ,-3(L)
20700 JRST L475
20800 CAMLE RJ,(L)
20900 JRST L476
21000 L475: CAMGE RJ,(L)
21100 CAMG RJ,-3(L)
21200 JRST L47
21300 ; H=HGHT(L,RJ,Q,R)
21400 L476: MOVE H,-2(L)
21500 CAMN H,1(L)
21600 JRST RET3
21700 MOVNS H
21800 FADR H,1(L)
21900 MOVE D,-3(L)
22000 MOVNS T,D
22100 FADR T,RJ
22200 FADR D,(L)
22300 FMPR H,T
22400 FDVR H,D
22500 FADR H,-2(L)
22600 ; IF(H.GT.XALT)GO TO 47
22700 RET3: CAMG H,XALT
22800
22900 ; IF(H.LE.B)GO TO 47
23000 CAMG H,B
23100 JRST L47
23200 ; B=H
23300 MOVE B,H
23400 ; JK=L
23500 HRRZI JK,(L)
23600 ; 47 CONTINUE
23700 JRST L47
23800 ; IF(JK)GO TO 48
23900 L477: JUMPL JK,L48
24000 ; 300 IF(ZALT-B.GT..001.OR.I.NE.J)GO TO 59
24100 MOVN T,B
24200 FADR T,ZALT
24300 CAMG T,[=0.001]
24400 CAME J,I
24500 JRST L59
24600 ; JX=Q(JK)
24700 MOVE T,(JK)
24800 FIXX(T)
24900 ; IF(JX.GT.KN)GO TO 60
25000 CAMLE T,KN
25100 JRST L60
25200 ; JX=Q(JK-1)
25300 MOVE T,-3(JK)
25400 FIXX(T)
25500 ; IF(JX.LT.KN)GO TO 59
25600 CAMGE T,KN
25700 JRST L59
25800 ; 60 L=JJ
25900 L60: MOVE L,JJ
26000 ; JJ=JK
26100 MOVE JJ,JK
26200 ; JK=L
26300 MOVE JK,L
26400 ; KN=JX
26500 MOVEM T,KN
26600
26700 ; 59 IF(ALT-B.LT.2)GO TO 62
26800 L59: MOVN T,B
26900 FADR T,AL
27000 CAMGE T,[=2.0]
27100 JRST L62
27200 ; ALT=ALT-1
27300 HRLZI T,576400
27400 FADR AL,T
27500 ; B=B+1
27600 HRLZI T,201400
27700 FADR B,T
27800 ; 62 IF(JORD)GO TO 103
27900 L62: SKIPGE JORD
28000 JRST L103
28100 ; H=B
28200 MOVE H,B
28300 ; B=ALT
28400 MOVE B,AL
28500 ; ALT=H
28600 MOVE AL,H
28700 ; IF(JK.NE.NK.AND.ABS(ALT-B).GT.5.)JA=3
28800
28900 CAMN JK,NK#
29000 JRST L103
29100 MOVN T,B
29200 FADR T,AL
29300 SKIPGE T
29400 MOVNS T
29500 CAMG T,[5.0]
29600 JRST L103
29700 HRRZI T,3
29800 HRRZM T,JA
29900 ; 103 CALL LINES(RJ,ALT,JA)
30000 L103: MOVEM RJ,SVRJ#
30100 MOVEM AL,SVAL#
30200 MOVEM B,SVB#
30300 HRRZI 16,SVAC
30400 BLT 16,SVAC+15
30500 JSA 16,LINES
30600 JUMP SVRJ
30700 JUMP SVAL
30800 JUMP JA
30900 ; 100 CALL LINES(RJ,B,2)
31000 JSA 16,LINES
31100 JUMP SVRJ
31200 JUMP SVB
31300 JUMP [2]
31400 HRLZI 16,SVAC
31500 BLT 16,15
31600 ; NK=JK
31700 MOVEM JK,NK
31800
31900 ; JORD=-JORD
32000 MOVNS JORD
32100 ; NE(JK)=1
32200 HRRZI T,1
32300 HRRZM T,2(JK)
32400 ; NE(JJ)=-1
32500 SETOM 2(JJ)
32600 ; JA=2
32700 HRRZI T,2
32800 HRRZM T,JA
32900 ; I=I+M
33000 MOVE T,SVM
33100 ADDB T,I
33200 ; IF(I.LT.KN)GO TO 102
33300 CAMGE T,KN
33400 JRST L102
33500 ; L=1
33600 HRRZI L,3
33700 ; IF(KN.EQ.KL)L=-1
33800 MOVE T,KN
33900 CAMN T,KL
34000 HRROI L,-3
34100 ; JJ=JJ+L
34200 ADD JJ,L
34300 ; J=0
34400 SETZ J,
34500 ; IF(L)J=-1
34600 SKIPGE L
34700 HRROI J,-3
34800 ; IF(KN+M.GT.Q(JJ+J).OR.JJ.GT.KK.OR.NE(JJ).NE.0)GO TO 124
34900 SKIPN 2(JJ)
35000 CAILE JJ,-2(KK)
35100 JRST L124
35200 ADD T,SVM
35300 FLOAT(T)
35400 HRRZI HG,(JJ)
35500 ADD HG,J
35600 CAMLE T,(HG)
35700 JRST L124
35800 ; J=I
35900 MOVE J,I
36000 ; GO TO 52
36100 JRST L52
36200 ; 48 JA=3
36300 L48: HRRZI T,3
36400 HRRZM T,JA
36500 ; 43 J=LEFT+M
36600 L43: MOVE J,LE
36700 ADD J,SVM
36800 ; IF(J.LE.LRT)GO TO 42
36900 CAMG J,LRT
37000 JRST L42
37100 ; IF(JCONT)GO TO 51
37200 SKIPGE JCONT
37300 JRST L51 ; END
37400 MOVE 16,SV16
37500 JRA 16,2(16)
37600 SVAC: BLOCK 16
37700
37800 EXTERNAL DST,PLTR,DPY
37900 ; SUBROUTINE LINES(A,B,L)
38000 ; COMMON/DST/BB,CC
38100 ; COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
38200 ; COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
38300 ; COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
38400 ; COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
38500 ; EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
38600 ; 1,(JJ2,JJ(2))
38700 ; DATA BB/.008/,CC/3.5/
38800 ;C SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
38900
39000 M←2 ↔ NX←3 ↔ K←4
39100
39200 LINES: 0
39300 ; GO TO 23
39400 JRST L23
39500 ;22 IF(JQ(1).NE.0)GO TO 23
39600 L22: SKIPE PLTR+=27
39700 JRST L23
39800 ; IF(CC.EQ.1000)GO TO 23
39900 MOVSI T,212764
40000 CAMN T,DST+1
40100 JRST L23
40200 ; B=B*(CC-BB*ABS(A))
40300 MOVE T,@(16)
40400 MOVMS T
40500 FMPR T,DST
40600 FSBR T,DST+1
40700 FMPRM T,@1(16)
40800 MOVNS @1(16)
40900 ;23 IF(IPLT)GO TO 2
41000 L23: SKIPGE PLTR
41100 ;; JRST L2
41150 JRST L9
41200 MOVE T,@1(16)
41300 CAMG T,DPY+1
41400 JRST L333
41500 MOVEM T,DPY+1 ; IF(B.LT.BOT)BOT=B
41600 JRA 16,3(16)
41700 L333: CAMG T,DPY+2
41800 MOVEM T,DPY+2
41900 JRA 16,3(16) ; IF(B.GT.TOP)TOP=B
42000 ;2 IF(IPLT.EQ.-2)RETURN
42100 ;;L2: MOVNI T,2
42200 ;; CAMN T,PLTR
42300 ;; JRA 16,3(16)
42400 ;9 M=ROFF(A*DIS)
42500 L9: MOVE M,@(16)
42600 FMPR M,PLTR+2
42700 SKIPGE M
42800 FADR M,[-=1.0]
42900 FADR M,[=0.5]
43000 FIXX(M)
43100 MOVEM M,MM#
43200 ; N=ROFF(B*RHT)
43300 MOVE NX,@1(16)
43400 FMPR NX,PLTR+1
43500 SKIPGE NX
43600 FADR NX,[-=1.0]
43700 FADR NX,[=0.5]
43800 FIXX(NX)
43900 MOVEM NX,NN#
44000 ;8 CALL PLOT(M,N,L)
44100 L8: MOVE T,@2(16)
44200 MOVEM T,LL#
44300 JSA 16,PLOT
44400 JUMP MM
44500 JUMP NN
44600 JUMP LL
44700 ; END
44800 JRA 16,3(16)
44900
45000 EXTERNAL OUTF,PUTFIL,FASTOU,FINFIL,EXIT,PAC
45100 LX: 0
45200 N: BLOCK =128
45300 PLOT: 0 ;SUBROUTINE PLOT(I,J,K)
45400 MOVE 4,OUTF ;COMMON /OUTF/JJ
45500 CAMN 4,[-1] ;DIMENSION N(148)
45600 JRST PL4 ;IF(JJ.EQ.-1)GO TO 4
45700 MOVEI 7,1 ;L=1
45800 MOVEM 7,LX
45900 MOVEI 4,=127 ;N(1)=127
46000 MOVEM 4,N
46100 MOVE 4,[ASCIZ/" "/] ;IF(JJ.EQ.' ')JJ='PLT'
46200 CAME 4,OUTF
46300 JRST PLB
46400 MOVE 4,[ASCIZ/"PLT"/]
46500 MOVEM 4,OUTF
46600 PLB: JSA 16,PUTFIL ;CALL PUTFIL(JJ)
46700 JUMP OUTF
46800 SETOM OUTF ;JJ=-1
46900 PL4: MOVE 5,@2(16) ;4 IF(K.EQ.99)GO TO 1
47000 CAIN 5,=99
47100 JRST PL1
47200 AOS LX ;L=L+1
47300 MOVEI 7,N
47400 ADD 7,LX ;CALL PAC(N(L),I)[SEE MSFAI.FAI]
47500 HRRZ 4,2(16)
47600 HRR 5,@4
47700 LSHC 5,-10
47800 HRRZ 4,1(16)
47900 HRR 5,@4
48000 LSHC 5,-16
48100 HRRZ 4,(16)
48200 HRR 5,@4
48300 LSHC 5,-16
48400 MOVEM 6,-1(7)
48500
48600 MOVE 7,LX
48700 CAIGE 7,=128 ;3 IF(L.LT.128)RETURN
48800 JRA 16,3(16)
49000 JSA 16,FASTOU ;2 CALL FASTOU(N,128)
49100 JUMP N
49200 JUMP [=128]
49300 MOVEI 7,1 ;L=1
49400 MOVEM 7,LX
49500 JRA 16,3(16) ;RETURN
49600 PL1: MOVE 5,LX ;1 N(1)=L
49700 MOVEM 5,N
49800 MOVEI 7,N ;J=N(L)
49900 ADD 7,5
50000 MOVE 7,-1(7)
50100 MOVEM 7,@1(16)
50200 PL100: MOVEI 4,N ;DO 100 JJ=L,128
50300 ADD 4,5 ;100 N(JJ)=J
50400 MOVEM 7,-1(4)
50500 CAIGE 5,=128
50600 AOJA 5,PL100
50700 JSA 16,FASTOU ;CALL FASTOU(N,128)
50800 JUMP N
50900 JUMP [=128]
51000 JSA 16,FINFIL ;CALL FINFIL
51100 SETZM OUTF ;JJ=0
51200 JSA 16,EXIT ;CALL EXIT
51300
51400 PLOTS: 0
51500 JRA 16,1(16) ; DUMMY ROUTINE
51600 END